Code
colnames_to_underscores <- function(data = NULL) {
dat <- data
names(dat) <- stringr::str_replace_all(names(dat), pattern = " ", replacement = "_")
return(dat)
}Our analysis will evaluate the pilot outcomes for the Perceived Social Categorization Study. Participants rated the same set of 85 photos for perceived “Jewishness” and “Arabness.” Our objective is to pinpoint images where the average ratings across these two dimensions do not significantly diverge. This nuanced approach enables us to select images that best represent a balanced perception, laying a robust foundation for our main study and ensuring the integrity and relevance of our visual stimuli.
Utilize the provided helper function colnames_to_underscores to standardize column names by replacing spaces and special characters with underscores.
colnames_to_underscores <- function(data = NULL) {
dat <- data
names(dat) <- stringr::str_replace_all(names(dat), pattern = " ", replacement = "_")
return(dat)
}get_summary_stats <- function(demo_wide_clean) {
summary_stats <- summary(demo_wide_clean)
return(summary_stats)
}Import data sets related to the main task, attention checks, and demographics.
data_categorization_jwish_first <- read_csv("../Data/data_exp_143127-v17_task-jwishfirstrealdata.csv", show_col_types = FALSE)
data_categorization_Arab_first <- read_csv("../Data/data_exp_143127-v17_task-4qo7Arabfirstrealdata.csv", show_col_types = FALSE)
att_check <- read_csv("../Data/data_exp_143127-v17_task-sfst_ATTcheck.csv", show_col_types = F)
data_demo <- read_csv("../Data/data_exp_143127-v17_questionnaire-jj6n_demo_all_long_for.csv", show_col_types = F)att_check <- att_check |>
colnames_to_underscores() |>
dplyr::filter(str_detect(Zone_Type, pattern = "endValue")) |>
dplyr::select(Participant_Private_ID, Response) |>
dplyr::mutate(Participant_Private_ID = factor(Participant_Private_ID))Identifying who failed the attention checks (answer > 5)
failed_IDs <- att_check |>
dplyr::filter(Response > 5) |>
dplyr::select(Participant_Private_ID)library(dplyr)
data_participants <- rbind(data_categorization_Arab_first,data_categorization_jwish_first)|>
colnames_to_underscores() |>
dplyr::filter(!(Participant_Private_ID %in% failed_IDs$Participant_Private_ID)) |>
dplyr::filter(display %in% c("task_Jewish", "task_Arab")) |> # removing instructions screens
dplyr::filter(Zone_Type == "response_slider_endValue") |> # only subjects answers
dplyr::select(Participant_Private_ID, Response, image, Reaction_Time, display, Task_Name) |>
mutate(Participant_Private_ID = factor(Participant_Private_ID),
image = factor(image),
Task_Name = factor(Task_Name),
display = factor(display)) |>
mutate(Task_Name = case_when(
Task_Name == "Group_categorization_JewishFirst_pilot2" ~ "JewishFirst",
Task_Name == "Group_categorization_ArabFirst_pilot2" ~ "ArabFirst",
TRUE ~ Task_Name
)) |>
rename(order_of_conditions = Task_Name)
num_participants <- n_distinct(data_participants$Participant_Private_ID)data set without the subject-
exclude_participant_IDs <- c("10528079", "10515904", "10520649", "10529232")
# # Combine data and perform initial processing with dynamic exclusion
# data_participants_Without_10513794 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10515904 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10520649 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
#
# data_participants_Without_10528079 <- data_participants|>
# dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
data_participants_without_all <- data_participants|>
dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
num_participants <- n_distinct(data_participants_without_all$Participant_Private_ID)Density plots for participants’ responses based on the dysplay conditions, labeled as “task Arab” versus “task Jewish.”
# same but with outliers
density_plot <- ggplot(data_participants_without_all, aes(x = Response, fill = display)) +
geom_density(alpha = 0.5) + # Plot density
geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
theme_minimal() +
labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
geom_vline(data = data_participants_without_all %>% group_by(display) |>
summarise(mean_response = mean(Response, na.rm = TRUE)),
aes(xintercept = mean_response),
linetype = "dashed", color = "black", size = 0.5)
ggsave("density_plot_without_some_subjects.png", density_plot, path = "../Plots_outliers/", width = 10, height = 8, units = "in", bg = "white")Identify and exclude outliers from our data set using The MAD-median rule for outlier removal as recommended by Bakker and Wicherts (2014).
Second option to pbtain the MAD MEDIAN ROLE for detecting outlires (better in my opinion) link.
#Threshold Determiantion
threshold <- 2.24
# Calculate the median and MAD for the Response column
median_response <- median(data_participants$Response, na.rm = TRUE)
mad_response <- mad(data_participants$Response, constant = 1, na.rm = TRUE)
lower_bound <- median_response - threshold * mad_response
upper_bound <- median_response + threshold * mad_response
outlier_indices <- which(data_participants$Response < lower_bound | data_participants$Response > upper_bound)
data_participants$is_outlier <- ifelse(data_participants$Response < lower_bound | data_participants$Response > upper_bound, 1, 0)
outliers <- data_participants[outlier_indices, ]
data_cleaned <- data_participants[!data_participants$Response %in% outliers$Response, ]
data_cleaned_without_some_subjects <- data_participants[!data_participants$Response %in% outliers$Response, ] |>
dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))
set.seed(14)
# test <- data_participants |>
# #mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = T, prob = c(.8, .2))) |>
# filter(is_outlier == 1) |>
# group_by(Participant_Private_ID) |>
# mutate(n_trials = n()) |>
# mutate(bad_trials = 85*2 - n_trials) |>
# mutate(percent_bad_trials = n_bad_trials / (85*2))
# #filter(percent_bad_trials <= 0.2)
# library(dplyr)
test1 <- data_participants |>
# mutate(is_outlier = sample(x = c(0, 1), size = nrow(data_participants), replace = TRUE, prob = c(.8, .2))) |>
filter(is_outlier == 1) |>
group_by(Participant_Private_ID) |>
mutate(bad_trials = n(),
#bad_trials = 85 * 2 - n_trials,
percent_bad_trials = bad_trials / (85 * 2))
num_participants_out <- n_distinct(test1$Participant_Private_ID)A table showing the average standard deviation of each subject’s ratings beyond display types
participant_sd_ratings <- data_participants_without_all |>
group_by(Participant_Private_ID) |>
summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
ungroup()
kable(participant_sd_ratings, caption = "Standard Deviation of Ratings for Each Participant")| Participant_Private_ID | SD_of_Ratings |
|---|---|
| 10514858 | 19.72960 |
| 10515072 | 41.73836 |
| 10515173 | 23.39740 |
| 10515193 | 31.32064 |
| 10515201 | 36.83332 |
| 10515243 | 40.58422 |
| 10515319 | 35.68966 |
| 10515327 | 32.17920 |
| 10515918 | 22.24714 |
| 10515942 | 10.57305 |
| 10515960 | 19.62875 |
| 10515998 | 35.48673 |
| 10516258 | 24.88498 |
| 10516270 | 25.19615 |
| 10516302 | 29.10667 |
| 10516415 | 32.04238 |
| 10516645 | 22.79964 |
| 10516756 | 20.96220 |
| 10517522 | 29.27106 |
| 10517752 | 37.97194 |
| 10517925 | 40.37224 |
| 10518377 | 24.35308 |
| 10519057 | 37.29496 |
| 10519217 | 11.59149 |
| 10519319 | 29.61986 |
| 10519805 | 32.12981 |
| 10520066 | 21.90053 |
| 10520207 | 32.73827 |
| 10520244 | 25.67647 |
| 10520416 | 28.98994 |
| 10520443 | 26.83289 |
| 10520738 | 28.81733 |
| 10522475 | 29.30831 |
| 10522511 | 18.49479 |
| 10522561 | 27.52098 |
| 10527960 | 31.49570 |
| 10528402 | 12.17067 |
| 10528576 | 30.03514 |
| 10530076 | 37.41983 |
| 10530576 | 20.11152 |
| 10530858 | 29.53245 |
| 10531834 | 23.79220 |
Examining how the order of conditions affects ratings of images as “Arab” or “Jewish,” to ensure there is no influence of presentation sequence on perceptions. Visualization of order effect
# Visualization of order effects
order_effect_plot <- ggplot(data_participants_without_all, aes(x = order_of_conditions, y = Response, fill = display)) +
geom_boxplot() +
stat_summary(fun = mean, geom = "errorbar", aes(ymax = ..y.., ymin = ..y..), width = 0.75, color = "red") +
facet_wrap(~display, scales = "free") +
labs(title = "Order Effect on Ratings",
x = "Order of Conditions",
y = "Rating") +
theme_minimal() +
theme(plot.background = element_rect(fill = "white"), # Set plot background to white
panel.background = element_rect(fill = "white"), # Ensure panel background is white
text = element_text(color = "black")) + # Ensure text is black
scale_fill_brewer(palette = "Pastel1")
ggsave("order_effect_without_outlires.png", order_effect_plot, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")Perform a t-test to see if there’s a significant difference in ratings between orders
mean_ratings_by_order <- data_participants_without_all |>
group_by(order_of_conditions, display) |>
summarise(mean_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
pivot_wider(names_from = display, values_from = mean_rating)
t_test_result_jewish <- t.test(Response ~ order_of_conditions,
data = dplyr::filter(data_participants_without_all, display == "task_Jewish"),
alternative = "two.sided")
t_test_result_arab <- t.test(Response ~ order_of_conditions,
data = dplyr::filter(data_participants_without_all, display == "task_Arab"),
alternative = "two.sided")t_test_results_without_all <- data.frame(
Display = c("Jewish", "Arab"),
Statistic = c(t_test_result_jewish$statistic, t_test_result_arab$statistic),
P_Value = c(t_test_result_jewish$p.value, t_test_result_arab$p.value) # Difference of means, NA for the second row
)
# Create a table from the results
kable(t_test_results_without_all, caption = "T-Test Results for Jewish and Arab Displays", format = "markdown")| Display | Statistic | P_Value |
|---|---|---|
| Jewish | 1.602234 | 0.1091925 |
| Arab | -2.229192 | 0.0258633 |
data_images_10<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -10 ~ "Arab",
avg_diff > 10 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_10 <- data_images_10 |>
dplyr::filter(abs(avg_diff) >= 10) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_10 <- data_images_10 |>
dplyr::filter(abs(avg_diff)<10)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_10, caption = "Difference of means with a cutoff of 10 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Jewish |
| IFD_M-136-N.png | 12.8809524 | Arab |
| IFD_M-420-N.png | 14.2619048 | Arab |
| CFD_M-213-N.png | 14.4047619 | Arab |
| IFD_M-117-N.png | 14.5952381 | Jewish |
| CFD_M-231-N.png | 14.7857143 | Jewish |
| CFD_M-222-N.png | 15.4047619 | Jewish |
| IFD_M-062-N.png | 15.4285714 | Arab |
| CFD_M-223-N.png | 15.6666667 | Arab |
| CFD_M-246-N.png | 16.1428571 | Arab |
| IFD_M-075-N.png | 16.7142857 | Arab |
| CFD_M-230-N.png | 16.8333333 | Arab |
| IFD_M-121-N.png | 16.8571429 | Jewish |
| IFD_M-036-N.png | 16.8809524 | Jewish |
| CFD_M-204-N.png | 16.9761905 | Jewish |
| IFD_M-100-N.png | 18.4285714 | Jewish |
| CFD_M-251-N.png | 18.6428571 | Jewish |
| IFD_M-042-N.png | 18.8809524 | Arab |
| IFD_M-122-N.png | 19.1190476 | Jewish |
| CFD_M-200-N.png | 19.3333333 | Jewish |
| CFD_M-221-N.png | 19.5952381 | Jewish |
| IFD_M-044-N.png | 19.6666667 | Arab |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_10 <- data_images_10 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 29 | 31 | 25 |
data_images_15<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -15 ~ "Arab",
avg_diff > 15 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_15 <- data_images_15 |>
dplyr::filter(abs(avg_diff) >= 15) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_15 <- data_images_15 |>
dplyr::filter(abs(avg_diff)<15)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_15, caption = "Difference of means with a cutoff of 15 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Ambiguous |
| IFD_M-136-N.png | 12.8809524 | Ambiguous |
| IFD_M-420-N.png | 14.2619048 | Ambiguous |
| CFD_M-213-N.png | 14.4047619 | Ambiguous |
| IFD_M-117-N.png | 14.5952381 | Ambiguous |
| CFD_M-231-N.png | 14.7857143 | Ambiguous |
| CFD_M-222-N.png | 15.4047619 | Jewish |
| IFD_M-062-N.png | 15.4285714 | Arab |
| CFD_M-223-N.png | 15.6666667 | Arab |
| CFD_M-246-N.png | 16.1428571 | Arab |
| IFD_M-075-N.png | 16.7142857 | Arab |
| CFD_M-230-N.png | 16.8333333 | Arab |
| IFD_M-121-N.png | 16.8571429 | Jewish |
| IFD_M-036-N.png | 16.8809524 | Jewish |
| CFD_M-204-N.png | 16.9761905 | Jewish |
| IFD_M-100-N.png | 18.4285714 | Jewish |
| CFD_M-251-N.png | 18.6428571 | Jewish |
| IFD_M-042-N.png | 18.8809524 | Arab |
| IFD_M-122-N.png | 19.1190476 | Jewish |
| CFD_M-200-N.png | 19.3333333 | Jewish |
| CFD_M-221-N.png | 19.5952381 | Jewish |
| IFD_M-044-N.png | 19.6666667 | Arab |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_15 <- data_images_15 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 35 | 28 | 22 |
data_images_20<- data_participants_without_all |>
group_by(image, Participant_Private_ID) |>
#dplyr::filter(!(Participant_Private_ID %in% exclude_participant_IDs))|>
dplyr::summarize(
task_Jewish = mean(Response[display == "task_Jewish"], na.rm = TRUE),
task_Arab = mean(Response[display == "task_Arab"], na.rm = TRUE),
.groups = 'drop' ) |> # Calculate the difference in ratings for each participant and image
mutate(diff_per_participant = task_Jewish - task_Arab) |>
# Aggregate at the image level
group_by(image) |>
dplyr::summarize(
avg_diff = mean(diff_per_participant, na.rm = TRUE),
.groups = 'drop') |># Classify based on the average difference
mutate(
rated_ethnicity = case_when(
avg_diff < -20 ~ "Arab",
avg_diff > 20 ~ "Jewish",
TRUE ~ "Ambiguous"
)
)|>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_20 <- data_images_20 |>
dplyr::filter(abs(avg_diff) >= 20) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_20 <- data_images_20 |>
dplyr::filter(abs(avg_diff)<20)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_20, caption = "Difference of means with a cutoff of 20 points")| image | avg_diff | rated_ethnicity |
|---|---|---|
| CFD_M-242-N.png | 0.4047619 | Ambiguous |
| CFD_M-212-N.png | 0.5476190 | Ambiguous |
| IFD_M-419-N.png | 0.5714286 | Ambiguous |
| CFD_M-236-N.png | 1.2380952 | Ambiguous |
| CFD_M-220-N.png | 1.3809524 | Ambiguous |
| CFD_M-234-N.png | 1.5000000 | Ambiguous |
| CFD_M-206-N.png | 1.8809524 | Ambiguous |
| IFD_M-018-N.png | 2.1904762 | Ambiguous |
| CFD_M-227-N.png | 2.2142857 | Ambiguous |
| CFD_M-224-N.png | 2.8571429 | Ambiguous |
| CFD_M-218-N.png | 4.0952381 | Ambiguous |
| CFD_M-211-N.png | 4.9761905 | Ambiguous |
| IFD_M-108-N.png | 5.1666667 | Ambiguous |
| CFD_M-214-N.png | 5.3809524 | Ambiguous |
| IFD_M-135-N.png | 5.3809524 | Ambiguous |
| IFD_M-416-N.png | 5.8095238 | Ambiguous |
| IFD_M-105-N.png | 6.2142857 | Ambiguous |
| CFD_M-237-N.png | 6.3095238 | Ambiguous |
| CFD_M-216-N.png | 6.5000000 | Ambiguous |
| CFD_M-248-N.png | 6.8571429 | Ambiguous |
| CFD_M-243-N.png | 7.0238095 | Ambiguous |
| CFD_M-229-N.png | 7.3571429 | Ambiguous |
| IFD_M-086-N.png | 7.5476190 | Ambiguous |
| CFD_M-247-N.png | 7.5714286 | Ambiguous |
| IFD_M-067-N.png | 7.9761905 | Ambiguous |
| CFD_M-253-N.png | 8.2380952 | Ambiguous |
| IFD_M-424-N.png | 9.8095238 | Ambiguous |
| CFD_M-225-N.png | 9.8809524 | Ambiguous |
| IFD_M-132-N.png | 9.9523810 | Ambiguous |
| IFD_M-421-N.png | 10.0476190 | Ambiguous |
| IFD_M-136-N.png | 12.8809524 | Ambiguous |
| IFD_M-420-N.png | 14.2619048 | Ambiguous |
| CFD_M-213-N.png | 14.4047619 | Ambiguous |
| IFD_M-117-N.png | 14.5952381 | Ambiguous |
| CFD_M-231-N.png | 14.7857143 | Ambiguous |
| CFD_M-222-N.png | 15.4047619 | Ambiguous |
| IFD_M-062-N.png | 15.4285714 | Ambiguous |
| CFD_M-223-N.png | 15.6666667 | Ambiguous |
| CFD_M-246-N.png | 16.1428571 | Ambiguous |
| IFD_M-075-N.png | 16.7142857 | Ambiguous |
| CFD_M-230-N.png | 16.8333333 | Ambiguous |
| IFD_M-121-N.png | 16.8571429 | Ambiguous |
| IFD_M-036-N.png | 16.8809524 | Ambiguous |
| CFD_M-204-N.png | 16.9761905 | Ambiguous |
| IFD_M-100-N.png | 18.4285714 | Ambiguous |
| CFD_M-251-N.png | 18.6428571 | Ambiguous |
| IFD_M-042-N.png | 18.8809524 | Ambiguous |
| IFD_M-122-N.png | 19.1190476 | Ambiguous |
| CFD_M-200-N.png | 19.3333333 | Ambiguous |
| CFD_M-221-N.png | 19.5952381 | Ambiguous |
| IFD_M-044-N.png | 19.6666667 | Ambiguous |
| CFD_M-252-N.png | 20.0238095 | Arab |
| CFD_M-239-N.png | 20.2380952 | Arab |
| IFD_M-033-N.png | 21.1904762 | Jewish |
| IFD_M-418-N.png | 21.5238095 | Jewish |
| IFD_M-441-N.png | 22.7619048 | Jewish |
| IFD_M-021-N.png | 22.8095238 | Jewish |
| IFD_M-051-N.png | 23.1190476 | Arab |
| IFD_M-111-N.png | 23.1190476 | Arab |
| CFD_M-210-N.png | 23.2142857 | Arab |
| IFD_M-087-N.png | 24.5238095 | Jewish |
| CFD_M-238-N.png | 24.8571429 | Arab |
| IFD_M-015-N.png | 25.1190476 | Jewish |
| IFD_M-113-N.png | 25.9047619 | Jewish |
| IFD_M-084-N.png | 26.2142857 | Arab |
| CFD_M-232-N.png | 26.7857143 | Arab |
| IFD_M-097-N.png | 27.3571429 | Arab |
| IFD_M-032-N.png | 27.4285714 | Arab |
| IFD_M-020-N.png | 28.1666667 | Arab |
| IFD_M-035-N.png | 28.9285714 | Jewish |
| CFD_M-235-N.png | 29.5238095 | Arab |
| IFD_M-049-N.png | 29.8095238 | Arab |
| IFD_M-017-N.png | 33.7857143 | Jewish |
| IFD_M-114-N.png | 34.0714286 | Jewish |
| CFD_M-250-N.png | 36.2380952 | Jewish |
| IFD_M-069-N.png | 38.3571429 | Arab |
| IFD_M-028-N.png | 40.6190476 | Jewish |
| CFD_M-201-N.png | 40.9761905 | Jewish |
| IFD_M-423-N.png | 41.7380952 | Arab |
| IFD_M-107-N.png | 47.4047619 | Arab |
| CFD_M-202-N.png | 49.4047619 | Arab |
| IFD_M-066-N.png | 59.4047619 | Arab |
| IFD_M-039-N.png | 60.4047619 | Arab |
| IFD_M-045-N.png | 60.8095238 | Arab |
| IFD_M-046-N.png | 68.8333333 | Arab |
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_20 <- data_images_20 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 51 | 21 | 13 |
Visualizing image ratings in both display forms.
plot_images <- data_participants_without_all |>
group_by(display, image) |>
mutate(per_condition_mean = mean(Response, na.rm = T)) |>
#filter(str_detect(image, pattern = "20")) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "red"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic()
ggsave("plot_images_without_all.png", plot = plot_images, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")data_participants <- data_participants_without_all |>
group_by(display, image, order_of_conditions) |>
mutate(per_condition_mean = mean(Response, na.rm = TRUE)) |>
ungroup()
plot_image_condition <- data_participants |>
mutate(order = case_when(display == "task_Arab" & order_of_conditions == "ArabFirst" ~ "First",
display == "task_Jewish" & order_of_conditions == "JewishFirst" ~ "First",
.default = "Second")) |>
ggplot(aes(y = Response, x = order, fill = display)) +
geom_violin(position = "dodge", color = "gray34") +
geom_point(aes(y = per_condition_mean), position = position_dodge(.9), color = "red", show.legend = F) +
facet_wrap(~image)
# Save the modified plot
ggsave("plot_images_order_condition_separated.png", plot = plot_image_condition,path = "../Plots_outliers/", width = 40, height = 40, units = "cm", bg = "white", limitsize = FALSE)# Ensure the data is grouped and then summarize
data_wide <- data_participants_without_all |>
group_by(image, display) |>
dplyr::summarize(mean_response = mean(Response, na.rm = TRUE), .groups = 'drop')
# Reshaping the data to wide format
data_wide <- data_wide |>
pivot_wider(names_from = display, values_from = mean_response)
# Calculating the difference
data_diff <- data_wide |>
mutate(diff = abs(`task_Arab` - `task_Jewish`), # Replace with your actual display column names
diff_less_than_22 = ifelse(diff < 10, "same", "no_same"))
# Merging the difference back into the original data
data_participants1 <- data_participants_without_all |>
left_join(data_diff, by = "image")
data_participants1 <- data_participants1 |>
group_by(image, display) |>
mutate(per_condition_mean = mean(Response, na.rm = TRUE)) |>
ungroup()
# Creating the plot
plot1 <- data_participants1 |>
ggplot(aes(x = display, y = Response, color = diff_less_than_22)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "mean"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic() +
scale_color_manual(values = c("same" = "#E84646", "no_same" = "black", "mean" = "#7B8FD4"))
# Display the plot
ggsave("plot1_without_all.png", plot = plot1, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")participant_conditions <- data_participants_without_all |>
distinct(Participant_Private_ID, order_of_conditions) |>
mutate(label = paste(Participant_Private_ID, ifelse(order_of_conditions == "JewishFirst", "Jewish first", "Arab first")))
plot_participants_condLabel <- data_participants_without_all |>
group_by(Participant_Private_ID, display) |>
mutate(participant_mean = mean(Response, na.rm = TRUE)) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = participant_mean, color = "red"), show.legend = FALSE) + # Highlighting participant mean
facet_wrap(~Participant_Private_ID, labeller = as_labeller(setNames(participant_conditions$label, participant_conditions$Participant_Private_ID))) +
scale_x_discrete(labels = c("Arab" = "Arab", "Jewish" = "Jewish")) +
scale_y_continuous(breaks = seq(0, 100, 10), labels = seq(0, 100, 10)) +
labs(x = "") +
theme_classic()
ggsave("plot_participants_without_all_label.png", plot = plot_participants_condLabel, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")Adding lines that connects between the ratings of each image:
plot_participants_with_line <- data_participants_without_all |>
ggplot(aes(x = display, y = Response)) +
geom_smooth(aes(x = display, y = Response, group = image), method = "lm", color = "gray84", se = F, inherit.aes = F) +
geom_smooth(aes(group = -1), method = "lm", se = F, color = "red") +
facet_wrap(~Participant_Private_ID) +
scale_y_continuous(limits = c(0, 100)) +
theme_classic()
ggsave("plot_line_participants_without_All.png", plot = plot_participants_with_line, path = "../Plots_outliers/", width = 4000, height = 4000, units = "px")data_demo <- data_demo |>
colnames_to_underscores() |>
dplyr::filter(!(Question_Key %in% c("BEGIN QUESTIONNAIRE", "END QUESTIONNAIRE"))) |>
dplyr::filter(Event_Index != "END OF FILE") |>
select(Participant_Private_ID, Question_Key, Response) |>
pivot_wider(names_from = Question_Key, values_from = Response)
#data_demo$gender[3] <- "אישה"demo_wide_clean <- data_demo |>
mutate(gender = case_when(`gender-quantised` == "1" ~ "man",
`gender-quantised` == "2" ~ "woman")) |>
select(-`gender-quantised`, -`gender-quantised`, -`gender-text`, -`ethnic-text`, -`religiosity-quantised`, -`scale_of_SES-quantised`, -`age-quantised`) |>
mutate(Participant_Private_ID = factor(Participant_Private_ID),
age = as.numeric(age),
children = as.numeric(children),
scale_of_SES = as.numeric(scale_of_SES))
# demo_wide_clean$`ethnic-1`[3] <- "ישראלי/ת"
# demo_wide_clean$`ethnic-4` <- "יהודי/ת"
# demo_wide_clean$education[3] <- " למדתי לימודים מתקדמים מעבר לתואר ראשון"demo_wide_clean <- demo_wide_clean |>
rename(ethnic = `ethnic-1`, SES = scale_of_SES, comment = `response-7`, ethnic2 = `ethnic-4`, )ggplot(demo_wide_clean, aes(x = age)) +
geom_histogram(bins = 50) +
scale_x_continuous(breaks = seq(17, 71, 2)) +
theme_classic()Summary Table for AGE stat:
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))
if (!requireNamespace("knitr", quietly = TRUE)) {
install.packages("knitr")
}
library(knitr)
# Generate a nice table using kable
kable(Age_stats, caption = "Summary Statistics for Age", format = "markdown")| as.numeric(demo_wide_clean$age) | |
|---|---|
| Min. :18.00 | |
| 1st Qu.:23.00 | |
| Median :30.00 | |
| Mean :29.49 | |
| 3rd Qu.:33.00 | |
| Max. :72.00 | |
| NA’s :2 |
Age_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$age, na.rm = TRUE),
median(demo_wide_clean$age, na.rm = TRUE),
sd(demo_wide_clean$age, na.rm = TRUE),
min(demo_wide_clean$age, na.rm = TRUE),
max(demo_wide_clean$age, na.rm = TRUE))
)
kable(Age_stats_df, caption = "Summary Statistics for Age", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 29.4898 |
| Median | 30.0000 |
| SD | 10.2533 |
| Min | 18.0000 |
| Max | 72.0000 |
ggplot(demo_wide_clean, aes(x = gender)) +
geom_histogram(stat = "count") +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic()male_per <- sum(demo_wide_clean$gender == "man", na.rm = TRUE) /
sum(!is.na(demo_wide_clean$gender))
female_per <- sum(demo_wide_clean$gender == "woman", na.rm = T) /
sum(!is.na(demo_wide_clean$gender))
a_baniari_per <- sum(demo_wide_clean$gender == "לא בינארי", na.rm = T)/
sum(!is.na(demo_wide_clean$gender))ggplot(demo_wide_clean, aes(x = religiosity)) +
geom_histogram(stat = "count") +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic()Summary Table for Religiosity stat:
religiosity_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$religiosity)))
Age_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$age)))
if (!requireNamespace("knitr", quietly = TRUE)) {
install.packages("knitr")
}
library(knitr)
str(demo_wide_clean)tibble [51 × 16] (S3: tbl_df/tbl/data.frame)
$ Participant_Private_ID: Factor w/ 51 levels "10514858","10515072",..: 1 2 3 4 5 6 7 8 9 10 ...
$ age : num [1:51] 19 72 22 19 27 22 19 26 27 29 ...
$ gender : chr [1:51] "man" "man" "man" "woman" ...
$ ethnic : chr [1:51] "ישראלי/ת" "ישראלי/ת" NA "ישראלי/ת" ...
$ ethnic2 : chr [1:51] "יהודי/ת" "יהודי/ת" NA "יהודי/ת" ...
$ ethnic-8 : chr [1:51] "חרד/ית" NA "חרד/ית" NA ...
$ religiosity : chr [1:51] "9" "3" "8" "1" ...
$ education : chr [1:51] "למדתי לימודים מתקדמים מעבר לתואר ראשון" "השלמתי תואר ראשון באוניברסיטה" "השלמתי בית ספר יסודי" "השלמתי בית ספר תיכון" ...
$ education-quantised : chr [1:51] "7" "6" "2" "4" ...
$ language : chr [1:51] "כן" "כן" "כן" "כן" ...
$ language -quantised : chr [1:51] "1" "1" "1" "1" ...
$ vision : chr [1:51] "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "ראייה מתוקנת (משקפיים/עדשות)" "כן" ...
$ vision-quantised : chr [1:51] "2" "2" "2" "1" ...
$ children : num [1:51] 1 2 1 0 0 0 0 0 0 3 ...
$ SES : num [1:51] 6 8 5 6 6 7 7 5 6 4 ...
$ comment : chr [1:51] NA NA NA NA ...
demo_wide_clean$religiosity <- as.numeric(as.character(demo_wide_clean$religiosity))
# Generate a nice table using kable
kable(religiosity_stats, caption = "Summary Statistics for religiosity", format = "markdown")| as.numeric(demo_wide_clean$religiosity) | |
|---|---|
| Min. : 1.000 | |
| 1st Qu.: 3.000 | |
| Median : 6.000 | |
| Mean : 5.588 | |
| 3rd Qu.: 8.000 | |
| Max. :10.000 |
relig_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$religiosity, na.rm = TRUE),
median(demo_wide_clean$religiosity, na.rm = TRUE),
sd(demo_wide_clean$religiosity, na.rm = TRUE),
min(demo_wide_clean$religiosity, na.rm = TRUE),
max(demo_wide_clean$religiosity, na.rm = TRUE))
)
kable(relig_stats_df, caption = "Summary Statistics for Religiosity", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 5.588235 |
| Median | 6.000000 |
| SD | 3.093066 |
| Min | 1.000000 |
| Max | 10.000000 |
demo_table <- flextable::summarizor(demo_wide_clean[,-1], overall_label = "overall") |>
flextable::as_flextable(sep_w = 0, spread_first_col = T)education_levels <- c('1' = 'Part of Primary School', '2' = 'Finished Primary School', '3' = 'Part of High School', '4' = 'Finished High School', '5' = 'In Bachelor\'s Degree', '6' = 'Finished Bachelor\'s Degree', '7' = 'Master\'s Degree', '8' = 'Prefer not to answer')
demo_wide_clean$education <- factor(demo_wide_clean$`education-quantised`, levels = c('1', '2', '3', '4', '5', '6', '7', '8'), labels = c('Part of Primary School', 'Finished Primary School', 'Part of High School', 'Finished High School', 'In Bachelor\'s Degree', 'Finished Bachelor\'s Degree', 'Master\'s Degree', 'Prefer not to answer'))
ggplot(demo_wide_clean, aes(x = education)) +
geom_bar() +
scale_y_continuous(breaks = seq(0, 200, 10)) +
theme_classic() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))ggplot(drop_na(demo_wide_clean, SES), aes(x = SES)) +
geom_histogram(stat = "count", binwidth = 1) +
stat_bin(binwidth = 1, geom = 'text', color = 'white', aes(label = after_stat(count)),
position = position_stack(vjust = 0.5)) +
scale_x_continuous(breaks = c(1:10)) +
scale_y_continuous(breaks = seq(0, 160, 10)) +
labs(title = "On a scale of 1-10 how would you rate your Social-Economic status?",
subtitle = "1 = Lowest status, 10 = Highest status",
y = "Number of participants",
x = "") +
theme_classic() +
theme(plot.title = element_text(family = "serif", hjust = 0.5, size = 16),
plot.subtitle = element_text(family = "serif", hjust = 0.5, size = 10))Summary Table for SES stat:
SES_stats <- get_summary_stats(as.data.frame(as.numeric(demo_wide_clean$SES)))
# Generate a nice table using kable
kable(SES_stats, caption = "Summary Statistics for SES", format = "markdown")| as.numeric(demo_wide_clean$SES) | |
|---|---|
| Min. :2.000 | |
| 1st Qu.:5.000 | |
| Median :6.000 | |
| Mean :5.824 | |
| 3rd Qu.:7.000 | |
| Max. :8.000 |
SES_stats_df <- data.frame(
Statistic = c("Mean", "Median", "SD", "Min", "Max"),
Value = c(mean(demo_wide_clean$SES, na.rm = TRUE),
median(demo_wide_clean$SES, na.rm = TRUE),
sd(demo_wide_clean$SES, na.rm = TRUE),
min(demo_wide_clean$SES, na.rm = TRUE),
max(demo_wide_clean$SES, na.rm = TRUE))
)
# Now generate the table with kable
kable(SES_stats_df, caption = "Summary Statistics for SES", format = "markdown")| Statistic | Value |
|---|---|
| Mean | 5.823529 |
| Median | 6.000000 |
| SD | 1.260252 |
| Min | 2.000000 |
| Max | 8.000000 |
Adding a new column to identify the initial responses, those presented during the first condition only.
data_participants_order <- data_participants_without_all |>
mutate(order = case_when(
display == "task_Arab" & order_of_conditions == "ArabFirst" ~ "First",
display == "task_Jewish" & order_of_conditions == "JewishFirst" ~ "First",
TRUE ~ "Second" # Note the change here from '.default' to 'TRUE'
))
data_participants_first_only <- data_participants_order |>
filter(order == "First")# same but with outliers
density_plot_first <- ggplot(data_participants_first_only, aes(x = Response, fill = display)) +
geom_density(alpha = 0.5) + # Plot density
geom_rug(aes(color = display), sides = "b") + # Add rug plot at the bottom
scale_fill_brewer(palette = "Pastel1") + # Use Pastel1 palette for fill
scale_color_brewer(palette = "Pastel1") + # Use Pastel1 palette for rug and mean line colors
theme_minimal() +
labs(title = "Density of Ratings by Display", x = "Rating", y = "Density") +
geom_vline(data = data_participants_first_only %>% group_by(display) |>
summarise(mean_response = mean(Response, na.rm = TRUE)),
aes(xintercept = mean_response),
linetype = "dashed", color = "black", size = 0.5)
ggsave("density_plot_only_first.png", density_plot_first, path = "../Plots_first/", width = 10, height = 8, units = "in", bg = "white")A table showing the average standard deviation of each subject’s ratings beyond display types
participant_sd_ratings_first <- data_participants_first_only |>
group_by(Participant_Private_ID) |>
summarise(SD_of_Ratings = sd(Response, na.rm = TRUE)) |>
ungroup()
kable(participant_sd_ratings_first, caption = "Standard Deviation of Ratings for Each Participant")| Participant_Private_ID | SD_of_Ratings |
|---|---|
| 10514858 | 21.82392 |
| 10515072 | 39.10622 |
| 10515173 | 23.01336 |
| 10515193 | 34.72058 |
| 10515201 | 36.20395 |
| 10515243 | 38.63941 |
| 10515319 | 33.84229 |
| 10515327 | 32.60062 |
| 10515918 | 18.02723 |
| 10515942 | 11.03608 |
| 10515960 | 21.52988 |
| 10515998 | 27.79639 |
| 10516258 | 25.53825 |
| 10516270 | 26.95892 |
| 10516302 | 23.18782 |
| 10516415 | 33.76182 |
| 10516645 | 19.74638 |
| 10516756 | 22.65539 |
| 10517522 | 20.80531 |
| 10517752 | 34.25632 |
| 10517925 | 38.87596 |
| 10518377 | 21.29545 |
| 10519057 | 30.84461 |
| 10519217 | 10.66527 |
| 10519319 | 32.69611 |
| 10519805 | 31.46824 |
| 10520066 | 17.28570 |
| 10520207 | 35.05864 |
| 10520244 | 27.08428 |
| 10520416 | 32.32034 |
| 10520443 | 24.22102 |
| 10520738 | 25.76987 |
| 10522475 | 24.71253 |
| 10522511 | 19.34941 |
| 10522561 | 25.75767 |
| 10527960 | 31.73418 |
| 10528402 | 14.74900 |
| 10528576 | 28.43895 |
| 10530076 | 36.29174 |
| 10530576 | 19.68271 |
| 10530858 | 31.83919 |
| 10531834 | 22.11642 |
data_images_comparison_10 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -10 ~ "Arab",
avg_diff > 10 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_10_first <- data_images_comparison_10 |>
dplyr::filter(abs(avg_diff) >= 10) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_10_first <- data_images_comparison_10 |>
dplyr::filter(abs(avg_diff)<10)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_10, caption = "Difference of means with a cutoff of 10 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Arab |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Jewish |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Jewish |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Jewish |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Jewish |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Arab |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Jewish |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Arab |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Jewish |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Arab |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Jewish |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Arab |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Jewish |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Jewish |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Jewish |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Jewish |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Jewish |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Jewish |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Arab |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Jewish |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Arab |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Jewish |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Arab |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Jewish |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
saveRDS(data_images_10, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_10 <- data_images_comparison_10 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_10, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 23 | 32 | 30 |
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:
ambiguous_images_comparison_10 <- merge(data_images_10, data_images_comparison_10, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_10 = filter(data_images_10, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_10 = filter(data_images_comparison_10, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_10 = intersect(ambiguous_images_all_10, ambiguous_images_first_10)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_10 = setdiff(ambiguous_images_all_10, ambiguous_images_first_10)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_10 = setdiff(ambiguous_images_first_10, ambiguous_images_all_10)
# Creating a summary table
summary_comparison_10 <- tibble(
Common_Ambiguous_10 = length(common_ambiguous_images_10),
Unique_Ambiguous_All_10 = length(unique_ambiguous_all_10),
Unique_Ambiguous_First_10 = length(unique_ambiguous_first_10)
)
# Display the summary
knitr::kable(summary_comparison_10,
caption = "Comparison of Ambiguous Images Across Different Conditions 10",
align = 'c')| Common_Ambiguous_10 | Unique_Ambiguous_All_10 | Unique_Ambiguous_First_10 |
|---|---|---|
| 21 | 8 | 2 |
Now let’s see the images id:
common_ambiguous_images_df_10 <- tibble(Image = common_ambiguous_images_10, Category = "Common Ambiguous")
unique_ambiguous_all_df_10 <- tibble(Image = unique_ambiguous_all_10, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_10 <- tibble(Image = unique_ambiguous_first_10, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_10 <- bind_rows(common_ambiguous_images_df_10, unique_ambiguous_all_df_10, unique_ambiguous_first_df_10)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_10,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 10",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| CFD_M-234-N.png | Unique Ambiguous All |
| IFD_M-108-N.png | Unique Ambiguous All |
| CFD_M-214-N.png | Unique Ambiguous All |
| IFD_M-086-N.png | Unique Ambiguous All |
| CFD_M-247-N.png | Unique Ambiguous All |
| CFD_M-253-N.png | Unique Ambiguous All |
| IFD_M-424-N.png | Unique Ambiguous All |
| IFD_M-132-N.png | Unique Ambiguous All |
| CFD_M-213-N.png | Unique Ambiguous First |
| CFD_M-223-N.png | Unique Ambiguous First |
data_images_comparison_15 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -15 ~ "Arab",
avg_diff > 15 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_15_first <- data_images_comparison_15 |>
dplyr::filter(abs(avg_diff) >= 15) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_15_first <- data_images_comparison_15 |>
dplyr::filter(abs(avg_diff)<15)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_15, caption = "Difference of means with a cutoff of 15 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Ambiguous |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Ambiguous |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Ambiguous |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Ambiguous |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Ambiguous |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Ambiguous |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Ambiguous |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Ambiguous |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Ambiguous |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Ambiguous |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Ambiguous |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Arab |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Jewish |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Jewish |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Jewish |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Jewish |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Jewish |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Jewish |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Arab |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Jewish |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Arab |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Jewish |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Arab |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Jewish |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
saveRDS(data_images_15, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_15 <- data_images_comparison_15 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_15, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 34 | 28 | 23 |
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the firs retings:
ambiguous_images_comparison_15 <- merge(data_images_15, data_images_comparison_15, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_15 = filter(data_images_15, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_15 = filter(data_images_comparison_15, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_15 = intersect(ambiguous_images_all_15, ambiguous_images_first_15)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_15 = setdiff(ambiguous_images_all_15, ambiguous_images_first_15)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_15 = setdiff(ambiguous_images_first_15, ambiguous_images_all_15)
# Creating a summary table
summary_comparison_15 <- tibble(
Common_Ambiguous_15 = length(common_ambiguous_images_15),
Unique_Ambiguous_All_15 = length(unique_ambiguous_all_15),
Unique_Ambiguous_First_15 = length(unique_ambiguous_first_15)
)
# Display the summary
knitr::kable(summary_comparison_15,
caption = "Comparison of Ambiguous Images Across Different Conditions 15",
align = 'c')| Common_Ambiguous_15 | Unique_Ambiguous_All_15 | Unique_Ambiguous_First_15 |
|---|---|---|
| 30 | 5 | 4 |
Now let’s see the images id:
common_ambiguous_images_df_15 <- tibble(Image = common_ambiguous_images_15, Category = "Common Ambiguous")
unique_ambiguous_all_df_15 <- tibble(Image = unique_ambiguous_all_15, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_15 <- tibble(Image = unique_ambiguous_first_15, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_15 <- bind_rows(common_ambiguous_images_df_15, unique_ambiguous_all_df_15, unique_ambiguous_first_df_15)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_15,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 15",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-234-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-108-N.png | Common Ambiguous |
| CFD_M-214-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-086-N.png | Common Ambiguous |
| CFD_M-247-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| IFD_M-424-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| IFD_M-421-N.png | Common Ambiguous |
| CFD_M-213-N.png | Common Ambiguous |
| IFD_M-117-N.png | Common Ambiguous |
| CFD_M-253-N.png | Unique Ambiguous All |
| IFD_M-132-N.png | Unique Ambiguous All |
| IFD_M-136-N.png | Unique Ambiguous All |
| IFD_M-420-N.png | Unique Ambiguous All |
| CFD_M-231-N.png | Unique Ambiguous All |
| CFD_M-223-N.png | Unique Ambiguous First |
| CFD_M-251-N.png | Unique Ambiguous First |
| IFD_M-418-N.png | Unique Ambiguous First |
| CFD_M-210-N.png | Unique Ambiguous First |
data_images_comparison_20 <- data_participants_first_only |>
group_by(image, display) |>
summarize(average_rating = mean(Response, na.rm = TRUE), .groups = 'drop') |>
spread(key = display, value = average_rating) |>
mutate(avg_diff = `task_Jewish` - `task_Arab`) |>
mutate(rated_ethnicity = case_when(
avg_diff < -20 ~ "Arab",
avg_diff > 20 ~ "Jewish",
TRUE ~ "Ambiguous"
)) |>
mutate(avg_diff = abs(avg_diff)) |>
arrange(avg_diff)
data_images_big_diff_20_first <- data_images_comparison_20 |>
dplyr::filter(abs(avg_diff) >= 20) |>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
data_images_choosen_20_first <- data_images_comparison_20 |>
dplyr::filter(abs(avg_diff)<20)|>
mutate(rated_ethnicity = case_when(avg_diff < 0 ~ "Arab",
avg_diff > 0 ~ "Jewish",
.default = NA))
kable(data_images_comparison_20, caption = "Difference of means with a cutoff of 20 points")| image | task_Arab | task_Jewish | avg_diff | rated_ethnicity |
|---|---|---|---|---|
| CFD_M-220-N.png | 26.86364 | 26.90 | 0.0363636 | Ambiguous |
| CFD_M-242-N.png | 21.63636 | 21.90 | 0.2636364 | Ambiguous |
| IFD_M-018-N.png | 48.40909 | 47.60 | 0.8090909 | Ambiguous |
| IFD_M-416-N.png | 55.77273 | 54.95 | 0.8227273 | Ambiguous |
| CFD_M-236-N.png | 45.09091 | 43.70 | 1.3909091 | Ambiguous |
| CFD_M-227-N.png | 26.81818 | 28.60 | 1.7818182 | Ambiguous |
| CFD_M-211-N.png | 29.18182 | 31.05 | 1.8681818 | Ambiguous |
| IFD_M-419-N.png | 52.04545 | 54.00 | 1.9545455 | Ambiguous |
| IFD_M-135-N.png | 52.00000 | 55.30 | 3.3000000 | Ambiguous |
| CFD_M-206-N.png | 29.72727 | 25.90 | 3.8272727 | Ambiguous |
| CFD_M-225-N.png | 22.77273 | 18.50 | 4.2727273 | Ambiguous |
| CFD_M-224-N.png | 36.95455 | 41.30 | 4.3454545 | Ambiguous |
| CFD_M-218-N.png | 32.59091 | 27.95 | 4.6409091 | Ambiguous |
| CFD_M-212-N.png | 24.81818 | 29.80 | 4.9818182 | Ambiguous |
| CFD_M-243-N.png | 30.40909 | 25.35 | 5.0590909 | Ambiguous |
| CFD_M-216-N.png | 22.45455 | 16.25 | 6.2045455 | Ambiguous |
| CFD_M-213-N.png | 34.36364 | 28.00 | 6.3636364 | Ambiguous |
| IFD_M-067-N.png | 40.95455 | 34.50 | 6.4545455 | Ambiguous |
| CFD_M-223-N.png | 30.36364 | 23.80 | 6.5636364 | Ambiguous |
| CFD_M-248-N.png | 20.59091 | 27.90 | 7.3090909 | Ambiguous |
| CFD_M-229-N.png | 29.59091 | 22.10 | 7.4909091 | Ambiguous |
| IFD_M-105-N.png | 44.00000 | 53.55 | 9.5500000 | Ambiguous |
| CFD_M-237-N.png | 43.54545 | 33.85 | 9.6954545 | Ambiguous |
| IFD_M-424-N.png | 45.00000 | 34.65 | 10.3500000 | Ambiguous |
| CFD_M-234-N.png | 18.54545 | 28.95 | 10.4045455 | Ambiguous |
| IFD_M-086-N.png | 30.72727 | 41.35 | 10.6227273 | Ambiguous |
| CFD_M-214-N.png | 15.90909 | 27.00 | 11.0909091 | Ambiguous |
| CFD_M-251-N.png | 25.54545 | 36.90 | 11.3545455 | Ambiguous |
| IFD_M-108-N.png | 56.59091 | 45.05 | 11.5409091 | Ambiguous |
| IFD_M-418-N.png | 43.50000 | 55.35 | 11.8500000 | Ambiguous |
| CFD_M-247-N.png | 31.40909 | 19.50 | 11.9090909 | Ambiguous |
| IFD_M-117-N.png | 35.36364 | 47.35 | 11.9863636 | Ambiguous |
| CFD_M-210-N.png | 41.95455 | 27.75 | 14.2045455 | Ambiguous |
| IFD_M-421-N.png | 45.09091 | 59.30 | 14.2090909 | Ambiguous |
| IFD_M-075-N.png | 57.09091 | 41.90 | 15.1909091 | Ambiguous |
| IFD_M-121-N.png | 37.72727 | 53.30 | 15.5727273 | Ambiguous |
| CFD_M-204-N.png | 36.04545 | 52.15 | 16.1045455 | Ambiguous |
| IFD_M-132-N.png | 46.31818 | 62.55 | 16.2318182 | Ambiguous |
| CFD_M-222-N.png | 17.40909 | 33.80 | 16.3909091 | Ambiguous |
| CFD_M-200-N.png | 19.40909 | 35.90 | 16.4909091 | Ambiguous |
| CFD_M-253-N.png | 21.22727 | 38.10 | 16.8727273 | Ambiguous |
| IFD_M-051-N.png | 57.09091 | 39.75 | 17.3409091 | Ambiguous |
| CFD_M-221-N.png | 23.81818 | 41.75 | 17.9318182 | Ambiguous |
| CFD_M-246-N.png | 43.45455 | 24.30 | 19.1545455 | Ambiguous |
| CFD_M-231-N.png | 19.77273 | 39.00 | 19.2272727 | Ambiguous |
| IFD_M-136-N.png | 63.40909 | 44.05 | 19.3590909 | Ambiguous |
| IFD_M-033-N.png | 42.90909 | 62.35 | 19.4409091 | Ambiguous |
| IFD_M-062-N.png | 67.90909 | 47.35 | 20.5590909 | Arab |
| CFD_M-230-N.png | 54.81818 | 34.15 | 20.6681818 | Arab |
| IFD_M-420-N.png | 49.31818 | 27.80 | 21.5181818 | Arab |
| IFD_M-111-N.png | 66.77273 | 45.05 | 21.7227273 | Arab |
| IFD_M-042-N.png | 62.68182 | 40.80 | 21.8818182 | Arab |
| IFD_M-122-N.png | 40.81818 | 62.90 | 22.0818182 | Jewish |
| IFD_M-100-N.png | 41.54545 | 64.25 | 22.7045455 | Jewish |
| IFD_M-084-N.png | 60.36364 | 37.60 | 22.7636364 | Arab |
| IFD_M-087-N.png | 32.77273 | 55.55 | 22.7772727 | Jewish |
| CFD_M-239-N.png | 48.81818 | 25.70 | 23.1181818 | Arab |
| IFD_M-044-N.png | 60.00000 | 35.75 | 24.2500000 | Arab |
| CFD_M-235-N.png | 50.86364 | 26.25 | 24.6136364 | Arab |
| IFD_M-015-N.png | 32.77273 | 57.50 | 24.7272727 | Jewish |
| IFD_M-097-N.png | 65.09091 | 39.50 | 25.5909091 | Arab |
| IFD_M-036-N.png | 36.09091 | 62.50 | 26.4090909 | Jewish |
| IFD_M-021-N.png | 36.95455 | 64.65 | 27.6954545 | Jewish |
| IFD_M-113-N.png | 24.59091 | 52.85 | 28.2590909 | Jewish |
| CFD_M-232-N.png | 51.00000 | 21.95 | 29.0500000 | Arab |
| IFD_M-441-N.png | 28.72727 | 57.95 | 29.2227273 | Jewish |
| IFD_M-032-N.png | 64.13636 | 34.70 | 29.4363636 | Arab |
| IFD_M-035-N.png | 35.00000 | 65.50 | 30.5000000 | Jewish |
| CFD_M-250-N.png | 17.77273 | 48.45 | 30.6772727 | Jewish |
| CFD_M-252-N.png | 58.31818 | 27.30 | 31.0181818 | Arab |
| IFD_M-114-N.png | 23.31818 | 54.40 | 31.0818182 | Jewish |
| IFD_M-049-N.png | 73.59091 | 41.25 | 32.3409091 | Arab |
| CFD_M-238-N.png | 53.22727 | 19.95 | 33.2772727 | Arab |
| IFD_M-020-N.png | 65.81818 | 31.25 | 34.5681818 | Arab |
| IFD_M-017-N.png | 28.18182 | 64.75 | 36.5681818 | Jewish |
| CFD_M-201-N.png | 22.81818 | 62.95 | 40.1318182 | Jewish |
| IFD_M-069-N.png | 68.45455 | 27.50 | 40.9545455 | Arab |
| IFD_M-423-N.png | 68.22727 | 25.20 | 43.0272727 | Arab |
| IFD_M-028-N.png | 21.45455 | 65.05 | 43.5954545 | Jewish |
| CFD_M-202-N.png | 68.72727 | 15.35 | 53.3772727 | Arab |
| IFD_M-066-N.png | 85.40909 | 31.15 | 54.2590909 | Arab |
| IFD_M-107-N.png | 74.63636 | 19.95 | 54.6863636 | Arab |
| IFD_M-045-N.png | 84.95455 | 25.90 | 59.0545455 | Arab |
| IFD_M-039-N.png | 79.86364 | 18.00 | 61.8636364 | Arab |
| IFD_M-046-N.png | 84.31818 | 15.20 | 69.1181818 | Arab |
saveRDS(data_images_20, file = "C:/Users/97252/Documents/GitHub/face_cater/PILOT- 1 face categorization/Data/final_data.rdx")Summary Table:
summary_table_20 <- data_images_comparison_20 |>
count(rated_ethnicity) |>
spread(key = rated_ethnicity, value = n)
# Print the summary table
kable(summary_table_20, format = "html", table.attr = "style='width:50%;'", caption = "Summary of Rated Ethnicity")| Ambiguous | Arab | Jewish |
|---|---|---|
| 47 | 24 | 14 |
Lets compare between the images when calculating the ratings based on all conditions VS when calculating only the first ratings:
ambiguous_images_comparison_20 <- merge(data_images_20, data_images_comparison_20, by = "image", suffixes = c("_all", "_first"))
# Extracting 'Ambiguous' images from both datasets
ambiguous_images_all_20 = filter(data_images_20, rated_ethnicity == "Ambiguous")$image
ambiguous_images_first_20 = filter(data_images_comparison_20, rated_ethnicity == "Ambiguous")$image
# Finding common 'Ambiguous' images in both datasets
common_ambiguous_images_20 = intersect(ambiguous_images_all_20, ambiguous_images_first_20)
# Finding 'Ambiguous' images unique to the all conditions dataset
unique_ambiguous_all_20 = setdiff(ambiguous_images_all_20, ambiguous_images_first_20)
# Finding 'Ambiguous' images unique to the first ratings dataset
unique_ambiguous_first_20 = setdiff(ambiguous_images_first_20, ambiguous_images_all_20)
# Creating a summary table
summary_comparison_20 <- tibble(
Common_Ambiguous_20 = length(common_ambiguous_images_20),
Unique_Ambiguous_All_20 = length(unique_ambiguous_all_20),
Unique_Ambiguous_First_20 = length(unique_ambiguous_first_20)
)
# Display the summary
knitr::kable(summary_comparison_20,
caption = "Comparison of Ambiguous Images Across Different Conditions 20",
align = 'c')| Common_Ambiguous_20 | Unique_Ambiguous_All_20 | Unique_Ambiguous_First_20 |
|---|---|---|
| 43 | 8 | 4 |
Now let’s see the images id:
common_ambiguous_images_df_20 <- tibble(Image = common_ambiguous_images_20, Category = "Common Ambiguous")
unique_ambiguous_all_df_20 <- tibble(Image = unique_ambiguous_all_20, Category = "Unique Ambiguous All")
unique_ambiguous_first_df_20 <- tibble(Image = unique_ambiguous_first_20, Category = "Unique Ambiguous First")
ambiguous_images_comparison_df_20 <- bind_rows(common_ambiguous_images_df_20, unique_ambiguous_all_df_20, unique_ambiguous_first_df_20)
# Display the comprehensive comparison
knitr::kable(ambiguous_images_comparison_df_20,
caption = "Comparison of Ambiguous Images Between All Conditions and First Ratings 20",
align = 'c')| Image | Category |
|---|---|
| CFD_M-242-N.png | Common Ambiguous |
| CFD_M-212-N.png | Common Ambiguous |
| IFD_M-419-N.png | Common Ambiguous |
| CFD_M-236-N.png | Common Ambiguous |
| CFD_M-220-N.png | Common Ambiguous |
| CFD_M-234-N.png | Common Ambiguous |
| CFD_M-206-N.png | Common Ambiguous |
| IFD_M-018-N.png | Common Ambiguous |
| CFD_M-227-N.png | Common Ambiguous |
| CFD_M-224-N.png | Common Ambiguous |
| CFD_M-218-N.png | Common Ambiguous |
| CFD_M-211-N.png | Common Ambiguous |
| IFD_M-108-N.png | Common Ambiguous |
| CFD_M-214-N.png | Common Ambiguous |
| IFD_M-135-N.png | Common Ambiguous |
| IFD_M-416-N.png | Common Ambiguous |
| IFD_M-105-N.png | Common Ambiguous |
| CFD_M-237-N.png | Common Ambiguous |
| CFD_M-216-N.png | Common Ambiguous |
| CFD_M-248-N.png | Common Ambiguous |
| CFD_M-243-N.png | Common Ambiguous |
| CFD_M-229-N.png | Common Ambiguous |
| IFD_M-086-N.png | Common Ambiguous |
| CFD_M-247-N.png | Common Ambiguous |
| IFD_M-067-N.png | Common Ambiguous |
| CFD_M-253-N.png | Common Ambiguous |
| IFD_M-424-N.png | Common Ambiguous |
| CFD_M-225-N.png | Common Ambiguous |
| IFD_M-132-N.png | Common Ambiguous |
| IFD_M-421-N.png | Common Ambiguous |
| IFD_M-136-N.png | Common Ambiguous |
| CFD_M-213-N.png | Common Ambiguous |
| IFD_M-117-N.png | Common Ambiguous |
| CFD_M-231-N.png | Common Ambiguous |
| CFD_M-222-N.png | Common Ambiguous |
| CFD_M-223-N.png | Common Ambiguous |
| CFD_M-246-N.png | Common Ambiguous |
| IFD_M-075-N.png | Common Ambiguous |
| IFD_M-121-N.png | Common Ambiguous |
| CFD_M-204-N.png | Common Ambiguous |
| CFD_M-251-N.png | Common Ambiguous |
| CFD_M-200-N.png | Common Ambiguous |
| CFD_M-221-N.png | Common Ambiguous |
| IFD_M-420-N.png | Unique Ambiguous All |
| IFD_M-062-N.png | Unique Ambiguous All |
| CFD_M-230-N.png | Unique Ambiguous All |
| IFD_M-036-N.png | Unique Ambiguous All |
| IFD_M-100-N.png | Unique Ambiguous All |
| IFD_M-042-N.png | Unique Ambiguous All |
| IFD_M-122-N.png | Unique Ambiguous All |
| IFD_M-044-N.png | Unique Ambiguous All |
| IFD_M-418-N.png | Unique Ambiguous First |
| CFD_M-210-N.png | Unique Ambiguous First |
| IFD_M-051-N.png | Unique Ambiguous First |
| IFD_M-033-N.png | Unique Ambiguous First |
Visualizing image ratings in both display forms.
plot_images_first <- data_participants_first_only |>
group_by(display, image) |>
mutate(per_condition_mean = mean(Response, na.rm = T)) |>
#filter(str_detect(image, pattern = "20")) |>
ggplot(aes(x = display, y = Response)) +
geom_point() +
geom_point(aes(y = per_condition_mean, color = "red"), show.legend = F) +
facet_wrap(~image, scales = "fixed") +
scale_y_continuous(labels = seq(0, 100, 10), breaks = seq(0, 100, 10)) +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1)) +
theme_classic()
ggsave("plot_images_without_all_first.png", plot = plot_images_first, path = "../Plots_first/", width = 4000, height = 4000, units = "px")Adding lines that connects between the ratings of each image:
plot_participants_with_line_first <- data_participants_order |>
ggplot(aes(x = display, y = Response)) +
geom_smooth(aes(x = display, y = Response, group = image), method = "lm", color = "gray84", se = F, inherit.aes = F) +
geom_smooth(aes(group = -1), method = "lm", se = F, color = "red") +
facet_wrap(~Participant_Private_ID) +
scale_y_continuous(limits = c(0, 100)) +
theme_classic()
ggsave("plot_line_participants_without_All.png", plot = plot_participants_with_line_first, path = "../Plots_first/", width = 4000, height = 4000, units = "px")